home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / infop125.zip / INFOPLUS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-08-10  |  14KB  |  668 lines
  1. (*
  2. **  INFOPLUS.PAS
  3. **
  4. **  Version 1.25 by Andrew Rossmann 8/10/90
  5. *)
  6.  
  7. (*$A-,B-,D-,L-,F-,I-,N-,O-,R-,S-,V-*)
  8. (*$M 16384, 0, 0*)
  9. program INFOPLUS;
  10.  
  11. uses
  12.   crt, dos, graph;
  13.  
  14. const
  15.   qversion = 'Version 1.25';
  16.   qdate = 'August 10, 1990';
  17.   BIOSdseg = $0040;
  18.   pgmax = 17;
  19.   pchar = [' '..'~'];
  20.   secsiz = 512;
  21.   tick1 = 1193180;
  22.  
  23. type
  24.   cpu_info_t = record
  25.     cpu_type : byte;
  26.     MSW : word;
  27.     GDT : array[1..6] of byte;
  28.     IDT : array[1..6] of byte;
  29.     intflag : boolean;
  30.     ndp_type : byte;
  31.     ndp_cw : word;
  32.     test_type: char
  33.   end;
  34.   char2 = string[2];
  35.  
  36. var
  37.   attrsave : byte;
  38.   country : array[0..33] of byte;
  39.   currdrv : byte;
  40.   devofs : word;
  41.   devseg : word;
  42.   dirsep : set of char;
  43.   DOScofs : word;
  44.   DOScseg : word;
  45.   DOSmem : longint;
  46.   equip : word;
  47.   graphdriver : integer;
  48.   i : word;
  49.   intvec : array[$00..$FF] of pointer;
  50.   lastdrv : byte;
  51.   osmajor : byte;
  52.   osminor : byte;
  53.   pg : 0..pgmax;
  54.   regs : registers;
  55.   switchar : char;
  56.   tlength : byte;
  57.   twidth : byte;
  58.   vidpg : byte;
  59.   x1 : byte;
  60.   x2 : byte;
  61.   xbool1 : boolean;
  62.   xbool2 : boolean;
  63.   xchar1 : char;
  64.   xchar2 : char;
  65.   xword : word;
  66.   gotcountry: boolean;
  67.   c2: char2;
  68.   endit: boolean;
  69.   ccode: word;
  70.  
  71. (*$L INFOPLUS*)
  72.  
  73. function getkey2: char2;
  74.   var
  75.     c: char;
  76.     c2: char2;
  77.  
  78.   begin
  79.   c:=ReadKey;
  80.   if c = #0 then
  81.     getkey2:=c + ReadKey
  82.   else
  83.     getkey2:=c;
  84.   end; {getkey2}
  85.  
  86. {^Make sure number entered, not any letters}
  87. function getnum: word;
  88.   var
  89.     inpchar: char;
  90.     number_string: string[2];
  91.     temp, position, code: word;
  92.     row, col: byte;
  93.     finish: boolean;
  94.  
  95.   begin
  96.   row:=WhereY;
  97.   col:=WhereX;
  98.   Write(' ':3);
  99.   GotoXY(col, row);
  100.   temp:=99;
  101.   finish:=false;
  102.   position:=0;
  103.   number_string:='';
  104.   TextColor(LightGray);
  105.   repeat
  106.     inpchar:=ReadKey;
  107.     case inpchar of
  108.       '0'..'9':if position < 2 then
  109.         begin
  110.         Inc(position);
  111.         Inc(number_string[0]);
  112.         number_string[position]:=inpchar;
  113.         Write(inpchar)
  114.         end;
  115.       #8: if position > 0 then
  116.         begin
  117.         Dec(position);
  118.         Dec(number_string[0]);
  119.         Write(^H' '^H)
  120.         end;
  121.       #27: if number_string = '' then
  122.           finish:=true
  123.         else
  124.           begin
  125.           number_string:='';
  126.           GotoXY(col, row);
  127.           ClrEol;
  128.           position:=0
  129.           end;
  130.       #13: finish:=true
  131.     end {case}
  132.   until finish;
  133.   if number_string <> '' then
  134.     Val(number_string, temp, code);
  135.   getnum:=temp
  136.   end; {getnum}
  137.  
  138. procedure caption1(a: string);
  139.   begin
  140.   textcolor(LightGray);
  141.   write(a);
  142.   textcolor(LightCyan)
  143.   end; {caption1}
  144.  
  145. procedure caption2(a: string);
  146.   const
  147.     capterm = ': ';
  148.  
  149.   var
  150.     i: byte;
  151.     xbool: boolean;
  152.  
  153.   begin
  154.   i:=length(a);
  155.   while (i > 0) and (a[i] = ' ') do
  156.     dec(i);
  157.   insert(capterm, a, i + 1);
  158.   caption1(a)
  159.   end; {caption2}
  160.  
  161. function nocarry : boolean;
  162.   begin
  163.   nocarry:=regs.flags and fcarry = $0000
  164.   end; {nocarry}
  165.  
  166. function hex(a : word; b : byte) : string;
  167.   const
  168.     digit : array[$0..$F] of char = '0123456789ABCDEF';
  169.  
  170.   var
  171.     i : byte;
  172.     xstring : string;
  173.  
  174.   begin
  175.   xstring:='';
  176.   for i:=1 to b do
  177.     begin
  178.     insert(digit[a and $000F], xstring, 1);
  179.     a:=a shr 4
  180.     end;
  181.   hex:=xstring
  182.   end; {hex}
  183.  
  184. procedure unknown(a : string; b : word; c : byte);
  185.   begin
  186.   writeln('(unknown', ' ', a, ' ', hex(b, c), ')')
  187.   end; {unknown}
  188.  
  189. procedure caption3(a : string);
  190.   begin
  191.   caption2('  ' + a)
  192.   end; {caption3}
  193.  
  194. procedure yesorno(a : boolean);
  195.   begin
  196.   if a then
  197.     writeln('yes')
  198.   else
  199.     writeln('no')
  200.   end; {yesorno}
  201.  
  202. procedure yesorno2(a: boolean);
  203.   begin
  204.   if a then
  205.     Write('yes')
  206.   else
  207.     Write('no')
  208.   end; {yesorno2}
  209.  
  210. procedure dontknow;
  211.   begin
  212.   writeln('(unknown)')
  213.   end; {dontknow}
  214.  
  215. procedure segofs(a, b : word);
  216.   begin
  217.   write(hex(a, 4), ':', hex(b, 4))
  218.   end; {segofs}
  219.  
  220. function showchar(a : char) : char;
  221.   begin
  222.   if a in pchar then
  223.     showchar:=a
  224.   else
  225.     showchar:='.'
  226.   end; {showchar}
  227.  
  228. procedure pause1;
  229.   var
  230.     xbyte : byte;
  231.     xchar : char2;
  232.     savex, savey: byte;
  233.  
  234.   begin
  235.   xbyte:=textattr;
  236.   endit:=false;
  237.   textcolor(Cyan);
  238.   savex:=WhereX;
  239.   savey:=WhereY;
  240.   Write('( for more)');
  241.   xchar:=getkey2;
  242.   if xchar <> #0#80 then
  243.     begin
  244.     endit:=true;
  245.     c2:=xchar
  246.     end;
  247.   textattr:=xbyte;
  248.   GotoXY(savex, savey);
  249.   Write('            ')
  250.   end; {pause1}
  251.  
  252. procedure pause2;
  253.   var
  254.     xbyte : byte;
  255.  
  256.   begin
  257.   if wherey + hi(windmin) > hi(windmax) then
  258.     begin
  259.     xbyte:=TextAttr;
  260.     TextColor(Cyan);
  261.     pause1;
  262.     clrscr;
  263.     writeln('(continued)');
  264.     textattr:=xbyte
  265.     end
  266.   end; {pause2}
  267.  
  268. function bin4(a : byte) : string;
  269.   const
  270.     digit : array[0..1] of char = '01';
  271.  
  272.   var
  273.     xstring : string;
  274.     i : byte;
  275.  
  276.   begin
  277.   xstring:='';
  278.   for i:=3 downto 0 do
  279.     begin
  280.     insert(digit[a mod 2], xstring, 1);
  281.     a:=a shr 1
  282.     end;
  283.   bin4:=xstring
  284.   end; {bin4}
  285.  
  286. procedure offoron(a : string; b : boolean);
  287.   begin
  288.   caption3(a);
  289.   if b then
  290.     writeln('on')
  291.   else
  292.     writeln('off')
  293.   end; {offoron}
  294.  
  295. procedure zeropad(a : word);
  296.   begin
  297.   if a < 10 then
  298.     write('0');
  299.   write(a)
  300.   end; {zeropad}
  301.  
  302. procedure showvers;
  303.   var
  304.     xchar : char;
  305.  
  306.   begin
  307.   xchar:=chr(country[9]);
  308.   if osmajor > 0 then
  309.     begin
  310.     write(osmajor, xchar);
  311.     zeropad(osminor);
  312.     writeln
  313.     end
  314.   else
  315.     writeln('1', xchar, 'x')
  316.   end; {showvers}
  317.  
  318. function cbw(a, b : byte) : word;
  319.   begin
  320.   cbw:=word(b) shl 8 + a
  321.   end; {cbw}
  322.  
  323. function bin16(a : word) : string;
  324.   function bin8(a : byte) : string;
  325.     begin
  326.     bin8:=bin4(a shr 4) + '_' + bin4(a and $0F)
  327.     end; {bin8}
  328.  
  329.   begin {bin16}
  330.   bin16:=bin8(hi(a)) + '_' + bin8(lo(a))
  331.   end; {bin16}
  332.  
  333. procedure drvname(a : byte);
  334.   begin
  335.   write(chr(ord('A') + a), ': ')
  336.   end; {drvname}
  337.  
  338. procedure media(a, b : byte);
  339.   procedure diskette(a, b, c : byte);
  340.     begin
  341.     writeln('floppy ', a, ' side, ', b, ' sctr, ', c, ' trk')
  342.     end; {diskette}
  343.  
  344.   begin {media}
  345.   caption3('Media');
  346.   case a of
  347.     $FF : diskette(2, 8, 40);
  348.     $FE : diskette(1, 8, 40);
  349.     $FD : diskette(2, 9, 40);
  350.     $FC : diskette(1, 9, 40);
  351.     $F9 : if b = 1 then
  352.       diskette(2, 15, 80)
  353.     else
  354.       diskette(2, 9, 80);
  355.     $F8 : writeln('fixed disk');
  356.     $F0 : diskette(2, 18, 80)
  357.     else
  358.       unknown('media', a, 2)
  359.   end
  360.   end; {media}
  361.  
  362. procedure pagenameclr;
  363.   var
  364.     xbyte: byte;
  365.  
  366.   begin
  367.   xbyte:=TextAttr;
  368.   Window(x1, tlength, x2 - 1, tlength);
  369.   TextColor((TextAttr and $70) shr 4);
  370.   ClrScr;
  371.   TextAttr:=xbyte;
  372.   Window(1, 1, twidth, tlength)
  373.   end; {pagenameclr}
  374.  
  375. procedure init;
  376.   var
  377.     xint : integer;
  378.  
  379.   procedure rjustify(a : string);
  380.     begin
  381.     gotoxy(1 + lo(windmax) - length(a), wherey);
  382.     x2:=WhereX;
  383.     write(a)
  384.     end; {rjustify}
  385.  
  386.   procedure border(ch: char);
  387.     var
  388.       i : byte;
  389.  
  390.     begin
  391.     TextColor(LightCyan);
  392.     for i:=1 to twidth do
  393.       write(ch);
  394.     TextColor(LightGray);
  395.     end; {border}
  396.  
  397.   begin {init}
  398.   attrsave:=textattr;
  399.   with regs do
  400.     begin
  401.     AH:=$0F;
  402.     intr($10, regs);
  403.     twidth:=AH;
  404.     vidpg:=BH
  405.     end;
  406.   detectgraph(graphdriver, xint);
  407.   if (graphdriver = EGA) or (graphdriver = MCGA) or (graphdriver = VGA) then
  408.     with regs do
  409.       begin
  410.       AX:=$1130;
  411.       BH:=$00;
  412.       intr($10, regs);
  413.       tlength:=DL + 1;
  414.       CheckSnow:=False;
  415.       end
  416.   else
  417.     tlength:=25;
  418.   with regs do
  419.     begin
  420.     intr($11, regs);
  421.     equip:=AX;
  422.     intr($12, regs);
  423.     DOSmem:=longint(AX) shl 10;
  424.     AH:=$19;
  425.     MSDOS(regs);
  426.     currdrv:=AL;
  427.     AH:=$34;
  428.     MSDOS(regs);
  429.     DOScseg:=ES;
  430.     DOScofs:=BX
  431.     end;
  432.   for i:=$00 to $FF do
  433.     getintvec(i, intvec[i]);
  434.   intvec[$00]:=saveint00;
  435.   intvec[$02]:=saveint02;
  436.   intvec[$1B]:=saveint1B;
  437.   intvec[$23]:=saveint23;
  438.   intvec[$24]:=saveint24;
  439.   intvec[$34]:=saveint34;
  440.   intvec[$35]:=saveint35;
  441.   intvec[$36]:=saveint36;
  442.   intvec[$37]:=saveint37;
  443.   intvec[$38]:=saveint38;
  444.   intvec[$39]:=saveint39;
  445.   intvec[$3A]:=saveint3A;
  446.   intvec[$3B]:=saveint3B;
  447.   intvec[$3C]:=saveint3C;
  448.   intvec[$3D]:=saveint3D;
  449.   intvec[$3E]:=saveint3E;
  450.   intvec[$3F]:=saveint3F;
  451.   intvec[$75]:=saveint75;
  452.   with regs do
  453.     begin
  454.     AX:=$3700;
  455.     MSDOS(regs);
  456.     switchar:=chr(DL)
  457.     end;
  458.   dirsep:=['\'];
  459.   if switchar <> '/' then
  460.     dirsep:=dirsep + ['/'];
  461.   with regs do
  462.     begin
  463.     AH:=$52;
  464.     MSDOS(regs);
  465.     devseg:=ES;
  466.     devofs:=BX
  467.     end;
  468.   lastdrv:=mem[devseg : devofs + $0021];
  469.   window(1, 1, twidth, tlength);
  470.   TextBackground(Blue);
  471.   clrscr;
  472.   textcolor(LightGreen);
  473.   write('INFO+');
  474.   textcolor(lightgray);
  475.   write(' - Information on all computer functions');
  476.   rjustify(qversion);
  477.   writeln;
  478.   border(#223);
  479.   gotoxy(1, tlength - 1);
  480.   border(#220);
  481.   write('Page ');
  482.   x1:=wherex;
  483.   textcolor(Lightgreen);
  484.   rjustify('Enter PgUp PgDn Home End Esc');
  485.   pg:=0;
  486.   endit:=false;
  487.   if osmajor >= 3 then
  488.     with regs do
  489.       begin
  490.       AX:=$3800;
  491.       DS:=seg(country);
  492.       DX:=ofs(country);
  493.       MSDOS(regs);
  494.       ccode:=BX
  495.       end;
  496.   end; {init}
  497.  
  498. procedure CPUID(var a : cpu_info_t);  external;
  499.  
  500. function diskread(drive : byte; starting_sector, number_of_sectors : word
  501.   ; var buffer) : word;  external;
  502.  
  503. procedure longcall(AXin: word; var address: longint; var AXo, BXo, DXo: word);
  504.   external;
  505.  
  506. function ATIinfo(data_in: byte; register: word): byte; external;
  507.  
  508. {$I PAGE_00.INC}
  509. {$I PAGE_01.INC}
  510. {$I PAGE_02.INC}
  511. {$I PAGE_03.INC}
  512. {$I PAGE_04.INC}
  513. {$I PAGE_05.INC}
  514. {$I PAGE_06.INC}
  515. {$I PAGE_07.INC}
  516. {$I PAGE_08.INC}
  517. {$I PAGE_09.INC}
  518. {$I PAGE_10.INC}
  519. {$I PAGE_11.INC}
  520. {$I PAGE_12.INC}
  521. {$I PAGE_13.INC}
  522. {$I PAGE_14.INC}
  523. {$I PAGE_15.INC}
  524. {$I PAGE_16.INC}
  525. {$I PAGE_17.INC}
  526. (*
  527. **  end subprograms
  528. *)
  529.  
  530. begin
  531.   xword:=dosversion;
  532.   osmajor:=lo(xword);
  533.   osminor:=hi(xword);
  534.   if osmajor >= 3 then
  535.     begin
  536.     init;
  537.     xbool1:=false;
  538.     repeat
  539.       pagenameclr;
  540.       gotoxy(x1, tlength);
  541.       textcolor(lightgray);
  542.       write(pg:2, ' - ');
  543.       case pg of
  544.         0 : Write('Table of Contents');
  545.         1 : Write('Machine & ROM Identification');
  546.         2 : Write('CPU Identification');
  547.         3 : Write('RAM Identification');
  548.         4 : Write('Memory Block Listing');
  549.         5 : Write('Video Identification');
  550.         6 : Write('Video Information');
  551.         7 : Write('Keyboard & Mouse Information');
  552.         8 : Write('Parallel/Serial Port Information');
  553.         9 : Write('DOS Information');
  554.         10: Write('Multiplex Programs');
  555.         11: Write('Environment Variables');
  556.         12: Write('Device Drivers');
  557.         13: Write('DOS Drive Information');
  558.         14: Write('BIOS Drive Information');
  559.         15: Write('Partition Table Listing');
  560.         16: Write('Boot info & DOS drive parameters');
  561.         17: Write('Thanks');
  562.       end;
  563.       window(1, 3, twidth, tlength - 2);
  564.       clrscr;
  565.       case pg of
  566.         0 : page_00;
  567.         1 : page_01;
  568.         2 : page_02;
  569.         3 : page_03;
  570.         4 : page_04;
  571.         5 : page_05;
  572.         6 : page_06;
  573.         7 : page_07;
  574.         8 : page_08;
  575.         9 : page_09;
  576.         10 : page_10;
  577.         11 : page_11;
  578.         12 : page_12;
  579.         13 : page_13;
  580.         14 : page_14;
  581.         15 : page_15;
  582.         16 : page_16;
  583.         17 : page_17
  584.       end;
  585.       window(1, 1, twidth, tlength);
  586.       gotoxy(x2 - 1, tlength);
  587.       xbool2:=false;
  588.       repeat
  589.         if not endit then
  590.           begin
  591.           repeat
  592.           until keypressed;
  593.           xchar1:=readkey;
  594.           if keypressed then
  595.             xchar2:=readkey
  596.           else
  597.             xchar2:=#0;
  598.           end
  599.         else
  600.           begin
  601.           endit:=false;
  602.           xchar1:=c2[1];
  603.           if Length(c2) = 1 then
  604.             xchar2:=#0
  605.           else
  606.             xchar2:=c2[2]
  607.           end;
  608.         if (xchar1 = #27) and (xchar2 = #0) then
  609.           begin
  610.           xbool2:=true;
  611.           xbool1:=true
  612.           end;
  613.         if (xchar1 = #13) and (xchar2 = #0) then
  614.           begin
  615.           pagenameclr;
  616.           GotoXY(x1, tlength);
  617.           TextColor(White);
  618.           Write('Go to page no.=> ');
  619.           i:=getnum;
  620.           if (i >= 0 ) and (i <= pgmax) then
  621.             begin
  622.             pg:=i;
  623.             xbool2:=true
  624.             end;
  625.           pagenameclr
  626.           end;
  627.         if xchar1 = #0 then
  628.           case xchar2 of
  629.             #71: begin
  630.                  xbool2:=true;
  631.                  pg:=0
  632.                  end;
  633.             #73: if pg > 0 then
  634.                    begin
  635.                    xbool2:=true;
  636.                    Dec(pg)
  637.                    end;
  638.             #79: begin
  639.                  xbool2:=true;
  640.                  pg:=pgmax
  641.                  end;
  642.             #81: if pg < pgmax then
  643.                    begin
  644.                    xbool2:=true;
  645.                    Inc(pg)
  646.                    end;
  647.           end;
  648.       if not xbool2 then
  649.         begin
  650.         Sound(220);
  651.         Delay(100);
  652.         NoSound
  653.         end
  654.       until xbool2
  655.     until xbool1;
  656.     textattr:=attrsave;
  657.     clrscr
  658.   end
  659. else
  660.   begin
  661.   writeln;
  662.   country[9]:=Ord('.');
  663.   writeln('INFOPLUS requires DOS version 3.0 or later');
  664.   write('Your DOS version is ');
  665.   showvers
  666.   end
  667. end.
  668.